InterCD 2001 January/january_2001.iso/intercd/root/^4Developers/VB/visbasdb/VBDB/VBDB Code/VB6 Code/Class 6/Exercise6AD.frm

Visual Basic Form | 1999-09-17 | 14.5 KB | 495 lines

VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form frmPublishers
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Publishers"
   ClientHeight    =   5580
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4650
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5580
   ScaleWidth      =   4650
   StartUpPosition =   3  'Windows Default
   Begin MSAdodcLib.Adodc datPublishers
      Height          =   330
      Left            =   2640
      Top             =   120
      Visible         =   0   'False
      Width           =   1935
      _ExtentX        =   3413
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   1
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=C:\VBDB\Working\Biblio.mdb"
      OLEDBString     =   "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=C:\VBDB\Working\Biblio.mdb"
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   "SELECT * FROM Publishers ORDER BY Name"
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin VB.TextBox txtInput
      DataField       =   "Comments"
      DataSource      =   "datPublishers"
      Height          =   285
      Index           =   9
      Left            =   1320
      Locked          =   -1  'True
      TabIndex        =   9
      Text            =   "Text1"
      Top             =   3360
      Width           =   3255
   End
   Begin VB.TextBox txtInput
      DataField       =   "Fax"
      DataSource      =   "datPublishers"
      Height          =   285
      Index           =   8
      Left            =   1320
      Locked          =   -1  'True
      TabIndex        =   8
      Text            =   "Text1"
      Top             =   3000
      Width           =   1575
   End
   Begin VB.TextBox txtInput
      DataField       =   "Telephone"
      DataSource      =   "datPublishers"
      Height          =   285
      Index           =   7
      Left            =   1320
      Locked          =   -1  'True
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   2640
      Width           =   1575
   End
   Begin VB.TextBox txtInput
      DataField       =   "Zip"
      DataSource      =   "datPublishers"
      Height          =   285
      Index           =   6
      Left            =   1320
      Locked          =   -1  'True
      TabIndex        =   6
      Text            =   "Text1"
      Top             =   2280
      Width           =   1575
   End
   Begin VB.TextBox txtInput
      DataField       =   "State"
      DataSource      =   "datPublishers"
      Height          =   285
      Index           =   5
      Left            =   1320
      Locked          =   -1  'True
      TabIndex        =   5
      Text            =   "Text1"
      Top             =   1920
      Width           =   1575
   End
   Begin VB.TextBox txtInput
      DataField       =   "City"
      DataSource      =   "datPublishers"
      Height          =   285
      Index           =   4
      Left            =   1320
      Locked          =   -1  'True
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   1560
      Width           =   3255
   End
   Begin VB.TextBox txtInput
      DataField       =   "Address"
      DataSource      =   "datPublishers"
      Height          =   285
      Index           =   3
      Left            =   1320
      Locked          =   -1  'True
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   1200
      Width           =   3255
   End
   Begin VB.TextBox txtInput
      DataField       =   "Company Name"
      DataSource      =   "datPublishers"
      Height          =   285
      Index           =   2
      Left            =   1320
      Locked          =   -1  'True
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   840
      Width           =   3255
   End
   Begin VB.TextBox txtInput
      DataField       =   "Name"
      DataSource      =   "datPublishers"
      Height          =   285
      Index           =   1
      Left            =   1320
      Locked          =   -1  'True
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   480
      Width           =   3255
   End
   Begin VB.CommandButton cmdHelp
      Caption         =   "&Help"
      Height          =   375
      Left            =   3240
      TabIndex        =   19
      TabStop         =   0   'False
      Top             =   5160
      Width           =   1215
   End
   Begin VB.CommandButton cmdDone
      Caption         =   "Do&ne"
      Height          =   375
      Left            =   3240
      TabIndex        =   18
      TabStop         =   0   'False
      Top             =   4680
      Width           =   1215
   End
   Begin VB.CommandButton cmdDelete
      Caption         =   "&Delete"
      Height          =   375
      Left            =   1680
      TabIndex        =   17
      TabStop         =   0   'False
      Top             =   4680
      Width           =   1215
   End
   Begin VB.CommandButton cmdEdit
      Caption         =   "&Edit"
      Height          =   375
      Left            =   120
      TabIndex        =   16
      TabStop         =   0   'False
      Top             =   4200
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   3240
      TabIndex        =   15
      TabStop         =   0   'False
      Top             =   4200
      Width           =   1215
   End
   Begin VB.CommandButton cmdSave
      Caption         =   "&Save"
      Height          =   375
      Left            =   1680
      TabIndex        =   14
      TabStop         =   0   'False
      Top             =   4200
      Width           =   1215
   End
   Begin VB.CommandButton cmdAddNew
      Caption         =   "&Add New"
      Height          =   375
      Left            =   120
      TabIndex        =   13
      TabStop         =   0   'False
      Top             =   4680
      Width           =   1215
   End
   Begin VB.CommandButton cmdNext
      Caption         =   "Next =>"
      Height          =   255
      Left            =   2520
      TabIndex        =   12
      TabStop         =   0   'False
      Top             =   3840
      Width           =   1215
   End
   Begin VB.CommandButton cmdPrevious
      Caption         =   "<= Previous"
      Height          =   255
      Left            =   1080
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   3840
      Width           =   1215
   End
   Begin VB.TextBox txtInput
      DataField       =   "PubID"
      DataSource      =   "datPublishers"
      Height          =   285
      Index           =   0
      Left            =   1320
      Locked          =   -1  'True
      TabIndex        =   10
      TabStop         =   0   'False
      Text            =   "Text1"
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Comments"
      Height          =   255
      Index           =   9
      Left            =   120
      TabIndex        =   28
      Top             =   3360
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "FAX"
      Height          =   255
      Index           =   8
      Left            =   120
      TabIndex        =   27
      Top             =   3000
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Telephone"
      Height          =   255
      Index           =   7
      Left            =   120
      TabIndex        =   26
      Top             =   2640
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Zip"
      Height          =   255
      Index           =   6
      Left            =   120
      TabIndex        =   25
      Top             =   2280
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "State"
      Height          =   255
      Index           =   5
      Left            =   120
      TabIndex        =   24
      Top             =   1920
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "City"
      Height          =   255
      Index           =   4
      Left            =   120
      TabIndex        =   23
      Top             =   1560
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Address"
      Height          =   255
      Index           =   3
      Left            =   120
      TabIndex        =   22
      Top             =   1200
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Company Name"
      Height          =   255
      Index           =   2
      Left            =   120
      TabIndex        =   21
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Name"
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   20
      Top             =   480
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Publisher ID"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
Attribute VB_Name = "frmPublishers"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
Private Const HELP_FINDER = &HB&
Private Sub ValidateData(AllOK As Boolean)
Dim Message As String
AllOK = True
'Check for name
If Len(txtInput(1).Text) = 0 Then
  Message = "You must enter a Publisher Name." & vbCrLf & Message
  txtInput(1).SetFocus
  AllOK = False
End If
If Not (AllOK) Then
  MsgBox Message, vbOKOnly + vbInformation, "Validation Error"
End If
End Sub
Private Sub cmdAddNew_Click()
On Error GoTo HandleErrors
Call SetState("Add")
Exit Sub
HandleErrors:
Select Case MsgBox(Err.Description, vbCritical + vbAbortRetryIgnore, "Error Number" + Str(Err.Number) + " in " + Err.Source)
Case vbAbort
  Exit Sub
Case vbRetry
  Resume
Case vbIgnore
  Resume Next
End Select
End Sub
Private Sub cmdCancel_Click()
Call SetState("View")
End Sub
Private Sub cmdDelete_Click()
Dim Response As Integer
On Error GoTo HandleErrors
Response = MsgBox("Are you sure you want to delete this record?", vbYesNo + vbQuestion + vbDefaultButton2, "Delete")
If Response = vbNo Then
  Exit Sub
End If
Exit Sub
HandleErrors:
Select Case MsgBox(Err.Description, vbCritical + vbAbortRetryIgnore, "Error Number" + Str(Err.Number) + " in " + Err.Source)
Case vbAbort
  Exit Sub
Case vbRetry
  Resume
Case vbIgnore
  Resume Next
End Select
End Sub
Private Sub cmdEdit_Click()
Call SetState("Edit")
End Sub
Private Sub cmdHelp_Click()
Dim Rtn As Long
Rtn = WinHelp(frmPublishers.hwnd, App.HelpFile, HELP_FINDER, CLng(0))
End Sub
Private Sub cmdNext_Click()
datPublishers.Recordset.MoveNext
If datPublishers.Recordset.EOF Then
  Beep
  datPublishers.Recordset.MoveLast
End If
End Sub
Private Sub cmdPrevious_Click()
datPublishers.Recordset.MovePrevious
If datPublishers.Recordset.BOF Then
  Beep
  datPublishers.Recordset.MoveFirst
End If
End Sub
Private Sub cmdSave_Click()
Dim Valid As Boolean
Call ValidateData(Valid)
If Not (Valid) Then Exit Sub
On Error GoTo HandleErrors
MsgBox "Record saved.", vbOKOnly + vbInformation, "Save"
Call SetState("View")
Exit Sub
HandleErrors:
Select Case MsgBox(Err.Description, vbCritical + vbAbortRetryIgnore, "Error Number" + Str(Err.Number) + " in " + Err.Source)
Case vbAbort
  Exit Sub
Case vbRetry
  Resume
Case vbIgnore
  Resume Next
End Select
End Sub
Private Sub SetState(AppState As String)
Dim I As Integer
Select Case AppState
Case "View"
  txtInput(0).BackColor = vbWhite
  For I = 1 To 9
    txtInput(I).Locked = True
  Next I
  cmdPrevious.Enabled = True
  cmdNext.Enabled = True
  cmdAddNew.Enabled = True
  cmdSave.Enabled = False
  cmdCancel.Enabled = False
  cmdEdit.Enabled = True
  cmdDelete.Enabled = True
  cmdDone.Enabled = True
  txtInput(1).SetFocus
Case "Add", "Edit"
  txtInput(0).BackColor = vbRed
  For I = 1 To 9
    txtInput(I).Locked = False
  Next I
  cmdPrevious.Enabled = False
  cmdNext.Enabled = False
  cmdAddNew.Enabled = False
  cmdSave.Enabled = True
  cmdCancel.Enabled = True
  cmdEdit.Enabled = False
  cmdDelete.Enabled = False
  cmdDone.Enabled = False
  txtInput(1).SetFocus
End Select
End Sub
Private Sub Form_Activate()
Call SetState("View")
End Sub
Private Sub txtInput_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
  If Index <> 9 Then
    txtInput(Index + 1).SetFocus
  Else
    txtInput(1).SetFocus
  End If
End If
End Sub